home *** CD-ROM | disk | FTP | other *** search
/ Young Minds / Young Minds Interactive CD-ROM.ISO / adl / samples / demos / multi.adl < prev    next >
Encoding:
Text File  |  1987-08-05  |  9.7 KB  |  418 lines
  1. OLDLOC = 27;        { Previous location of an actor }
  2. MYNAME = 26;        { Name of an actor }
  3.  
  4. VAR
  5.     NumAct,        { Number of active actors }
  6.     InitAct[ 5 ],    { Initial array of actors }
  7.     Rooms[ 4 ],        { Initial array of rooms }
  8.     Actors[ 5 ];    { List of active actors }
  9.  
  10. VERB
  11.     north, south, east, west,
  12.     northeast, southeast, northwest, southwest,
  13.     up, down, quit, take, drop;
  14.  
  15. ROUTINE
  16.     Transit, EnterDir, LeaveDir,
  17.     Looker, Prompter, SetActor,
  18.     Tell, Broadcast, ActAction,
  19.     ActLdesc, CG;
  20.  
  21. ARTICLE
  22.     the, a, an;
  23.  
  24. { Locations in the dungeon }
  25.  
  26. NOUN
  27.     room1, room2, room3, room4;
  28.  
  29. (Rooms+0) = room1;
  30. (Rooms+1) = room2;
  31. (Rooms+2) = room3;
  32. (Rooms+3) = room4;
  33.  
  34. { Actors in the dungeon }
  35. NOUN
  36.     actor1,
  37.     actor2,
  38.     actor3,
  39.     actor4,
  40.     actor5;
  41.  
  42. (InitAct + 0) = actor1;
  43. (InitAct + 1) = actor2;
  44. (InitAct + 2) = actor3;
  45. (InitAct + 3) = actor4;
  46. (InitAct + 4) = actor5;
  47.  
  48. { Objects in the dungeon }
  49. NOUN
  50.     foo( room1 ),
  51.     bar( room2 ),
  52.     bletch( room3 ),
  53.     ack( room4 );
  54.  
  55.  
  56. { Location properties }
  57.  
  58. room1( LDESC ) = ($say "Room 1.  Exits to the east and south.\n");
  59. room1( ACTION ) =
  60.     ($hit .ME    0  room3 room2 0  0  0  0  0  0  0)
  61.     ($miss    CG 0     0     CG CG CG CG CG CG CG)
  62.     (Transit @Verb)
  63. ;
  64.  
  65. room2( LDESC ) = ($say "Room 2.  Exits to the west and south.\n");
  66. room2( ACTION ) =
  67.     ($hit .ME    0  room4 0  room1 0  0  0  0  0  0)
  68.     ($miss    CG 0     CG 0     CG CG CG CG CG CG)
  69.     (Transit @Verb)
  70. ;
  71.  
  72. room3( LDESC ) = ($say "Room 3.  Exits to the east and north.\n");
  73. room3( ACTION ) =
  74.     ($hit .ME    room1 0  room4 0  0  0  0  0  0  0)
  75.     ($miss    0     CG 0     CG CG CG CG CG CG CG)
  76.     (Transit @Verb)
  77. ;
  78.  
  79. room4( LDESC ) = ($say "Room 4.  Exits to the west and north.\n");
  80. room4( ACTION ) =
  81.     ($hit .ME    room2 0  0  room3 0  0  0  0  0  0)
  82.     ($miss    0     CG CG 0     CG CG CG CG CG CG)
  83.     (Transit @Verb)
  84. ;
  85.  
  86.  
  87. { Object properties }
  88.  
  89. foo( LDESC ) = ($say "There is a foo here.\n");
  90. bar( LDESC ) = ($say "There is a bar here.\n");
  91. bletch( LDESC ) = ($say "There is a bletch here.\n");
  92. ack( LDESC ) = ($say "There is an ack here.\n");
  93.  
  94.  
  95.  
  96. { Verb properties }
  97.  
  98. take( PREACT ) =
  99.     (IF ($or ($ne @Iobj 0) ($lt @Dobj 0)) THEN
  100.     ($say "I don't understand that.\n")
  101.     ($exit 1)
  102.      ELSEIF ($eq @Dobj 0) THEN
  103.     ($say "You must tell me what to take!\n")
  104.     ($exit 1)
  105.      ELSEIF ($ne ($loc @Dobj) ($loc .ME)) THEN
  106.     ($say "You don't see that here.\n")
  107.     ($exit 1)
  108.      ELSEIF ($ne ($prop @Dobj MYNAME) 0) THEN
  109.     ($say "You can't take " ($prop @Dobj MYNAME) "!\n")
  110.     ($exit 1)
  111.     )
  112. ;
  113. take( ACTION ) =
  114.     ($say ($name @Dobj) " - taken\n")
  115.     (Broadcast ($prop .ME MYNAME) " takes the " ($name @Dobj) "\n")
  116.     ($move @Dobj .ME)
  117. ;
  118.  
  119. drop( PREACT ) =
  120.     (IF ($or ($ne @Iobj 0) ($lt @Dobj 0)) THEN
  121.     ($say "I don't understand that.\n")
  122.     ($exit 1)
  123.      ELSEIF ($eq @Dobj 0) THEN
  124.     ($say "You must tell me what to drop!\n")
  125.     ($exit 1)
  126.      ELSEIF ($ne ($loc @Dobj) .ME) THEN
  127.     ($say "You don't have that.\n")
  128.     ($exit 1)
  129.     )
  130. ;
  131. drop( ACTION ) =
  132.     ($say ($name @Dobj) " - dropped\n")
  133.     (Broadcast ($prop .ME MYNAME) " drops the " ($name @Dobj) "\n")
  134.     ($move @Dobj ($loc .ME))
  135. ;
  136.  
  137.  
  138. quit( PREACT ) =
  139. LOCAL i, obj1, obj2;
  140.     (Broadcast ($prop .ME MYNAME) " disappears in a puff of smoke!\n")
  141.     ($setg obj1 ($cont .ME))
  142.     (WHILE @obj1 DO
  143.     ($setg obj2 ($link @obj1))
  144.     ($move @obj1 .ALL)
  145.     ($setg obj1 @obj2)
  146.     )
  147.     ($setg i 0)
  148.     ($setg obj1 ($global ($plus Actors @i)))
  149.     (WHILE ($ne @obj1 .ME) DO
  150.     ($setg i ($plus @i 1))
  151.     ($setg obj1 ($global ($plus @Actors @i)))
  152.     )
  153.     ($setg NumAct ($minus @NumAct 1))
  154.     (IF ($le @NumAct 0) THEN
  155.     ($say "Goodbye!\n")
  156.     ($spec 3)
  157.     )
  158.     (WHILE ($lt @i @NumAct) DO
  159.     ($setg ($plus Actors @i) ($global ($plus Actors ($plus @i 1))))
  160.     ($setg i ($plus @i 1))
  161.     )
  162.     ($move .ME .ALL)
  163.     ($delact .ME)
  164.     ($exit 1)
  165. ;
  166.  
  167. { Utility routines }
  168.  
  169. Prompter =
  170.     ($say "\n" ($prop .ME MYNAME) ": ")
  171. ;
  172.  
  173.  
  174. CG = ($say "You can't go that way.\n") ($exit 1);
  175.  
  176. EnterDir =
  177.     (IF ($eq %1 north) THEN
  178.     ($val " from the south")
  179.      ELSEIF ($eq %1 south) THEN
  180.     ($val " from the north")
  181.      ELSEIF ($eq %1 east) THEN
  182.     ($val " from the west")
  183.      ELSEIF ($eq %1 west) THEN
  184.     ($val " from the east")
  185.      ELSEIF ($eq %1 northeast) THEN
  186.     ($val " from the southwest")
  187.      ELSEIF ($eq %1 southeast) THEN
  188.     ($val " from the northwest")
  189.      ELSEIF ($eq %1 northwest) THEN
  190.     ($val " from the southeast")
  191.      ELSEIF ($eq %1 southwest) THEN
  192.     ($val " from the northeast")
  193.      ELSEIF ($eq %1 up) THEN
  194.     ($val " from below")
  195.      ELSEIF ($eq %1 down) THEN
  196.     ($val " from above")
  197.      ELSE
  198.     ($val "")
  199.     )
  200. ;
  201.  
  202. LeaveDir =
  203.     (IF ($eq %1 north) THEN
  204.     ($val " to the north")
  205.      ELSEIF ($eq %1 south) THEN
  206.     ($val " to the south")
  207.      ELSEIF ($eq %1 east) THEN
  208.     ($val " to the east")
  209.      ELSEIF ($eq %1 west) THEN
  210.     ($val " to the west")
  211.      ELSEIF ($eq %1 northeast) THEN
  212.     ($val " to the northeast")
  213.      ELSEIF ($eq %1 southeast) THEN
  214.     ($val " to the southeast")
  215.      ELSEIF ($eq %1 northwest) THEN
  216.     ($val " to the northwest")
  217.      ELSEIF ($eq %1 southwest) THEN
  218.     ($val " to the southwest")
  219.      ELSEIF ($eq %1 up) THEN
  220.     ($val ", going up")
  221.      ELSEIF ($eq %1 down) THEN
  222.     ($val ", going down")
  223.      ELSE
  224.     ($val "")
  225.     )
  226. ;
  227.  
  228. ActLdesc =
  229.     ($say ($prop %1 MYNAME) " is here.\n")
  230. ;
  231.  
  232. ActAction =
  233.     ($setp .ME OLDLOC ($loc .ME))
  234.     { Other stuff, as appropriate }
  235. ;
  236.  
  237. Looker =
  238. LOCAL obj;
  239.     { Pretty standard stuff, nothing unusual.  Note that
  240.       the TTY is set up by ADL, not by this program }
  241.     ($say "\n" ($prop .ME MYNAME) " sees:\n")
  242.     ( ($ldesc ($loc .ME)) )
  243.     ($setg obj ($cont ($loc .ME)))
  244.     (WHILE @obj DO
  245.     (IF ($ne @obj .ME) THEN
  246.         ( ($ldesc @obj) @obj )
  247.     )
  248.     ($setg obj ($link @obj))
  249.     )
  250. ;
  251.  
  252. { (SetActor "name" actor loc tty) Sets up an actor with a tty }
  253. SetActor =
  254.     ($actor %2 0 1)
  255.     ($move %2 %3)
  256.     ($setp %2 OLDLOC %3)
  257.     ($setp %2 LDESC ActLdesc)
  258.     ($setp %2 ACTION ActAction)
  259.     ($setp %2 MYNAME
  260.     ($savestr
  261.         ($cat
  262.         ($chr ($minus ($ord %1) 32))
  263.         ($subs %1 1 0)
  264.         )
  265.     )
  266.     )
  267.     {$spec 11 %1 %4}
  268.     ($setg ($plus Actors @NumAct) %2)
  269.     ($setg NumAct ($plus @NumAct 1))
  270. ;
  271.  
  272. { (Tell foo msg1 msg ... ) - prints msg on foo's tty }
  273. Tell =
  274. LOCAL i;
  275.     {$spec 12 %1}
  276.     ($say ($prop %1 MYNAME) ": ")
  277.     ($setg i 2)
  278.     (WHILE ($le @i %0) DO
  279.     ($say ($arg @i))
  280.     ($setg i ($plus @i 1))
  281.     )
  282.     {$spec 12 .ME}
  283. ;
  284.  
  285. { (Broadcast msg msg ... ) - prints messages to everybody where I am }
  286. Broadcast =
  287. LOCAL i, j, him;
  288.     { Check those actors who have already acted }
  289.     ($setg i ($minus @NumAct 1))
  290.     ($setg him ($global ($plus Actors @i)))
  291.     (WHILE ($ne @him .ME) DO
  292.     (IF ($and    ($eq ($loc @him) ($loc .ME))
  293.             ($eq ($prop @him OLDLOC) ($loc .ME)) )
  294.      THEN
  295.         { He was and still is in the room }
  296.         {$spec 12 @him}
  297.         ($say ($prop @him MYNAME) ": ")
  298.         ($setg j 1)
  299.         (WHILE ($le @j %0) DO
  300.         ($say ($arg @j))
  301.         ($setg j ($plus @j 1))
  302.         )
  303.     )
  304.     ($setg i ($minus @i 1))
  305.     ($setg him ($global ($plus Actors @i)))
  306.     )
  307.  
  308.     { Check the rest of the actors }
  309.     ($setg i ($minus @i 1))
  310.     (WHILE ($ge @i 0) DO
  311.     ($setg him ($global ($plus Actors @i)))
  312.     (IF ($eq ($loc @him) ($loc .ME)) THEN
  313.         { He is in the room with me }
  314.         {$spec 12 @him}
  315.         ($say ($prop @him MYNAME) ": ")
  316.         ($setg j 1)
  317.         (WHILE ($le @j %0) DO
  318.         ($say ($arg @j))
  319.         ($setg j ($plus @j 1))
  320.         )
  321.     )
  322.     ($setg i ($minus @i 1))
  323.     )
  324.     {$spec 12 .ME}
  325. ;
  326.  
  327. { Transit - a routine to be called in every room ACTION }
  328.  
  329. Transit =
  330. LOCAL
  331.     HisOld,
  332.     MyOld,
  333.     HisNew,
  334.     MyNew,
  335.     MyName,
  336.     Him,
  337.     I;
  338.  
  339.     ($setg MyOld ($prop .ME OLDLOC))
  340.     ($setg MyNew ($loc .ME))
  341.     ($setg MyName ($prop .ME MYNAME))
  342.  
  343.     (IF ($eq @MyOld @MyNew) THEN
  344.     { I didn't move }
  345.     ($return 0)
  346.     )
  347.  
  348.     { Examine those actors who have already acted }
  349.     ($setg I ($minus @NumAct 1))
  350.     ($setg Him ($global ($plus Actors @I)))
  351.     (WHILE ($ne @Him .ME) DO
  352.     ($setg HisOld ($prop @Him OLDLOC))
  353.     ($setg HisNew ($loc @Him))
  354.     (IF    ($and    ($eq @MyOld @HisOld) ($eq @HisOld @HisNew))    THEN
  355.         (Tell @Him @MyName " left" (LeaveDir %1) ".\n")
  356.      ELSEIF    ($and    ($eq @MyOld @HisOld) ($eq @MyNew @HisNew))    THEN
  357.         (Tell @Him @MyName " followed you" (EnterDir %1) ".\n")
  358.      ELSEIF    ($and    ($eq @MyOld @HisNew) ($ne @HisOld @HisNew))    THEN
  359.         (Tell @Him @MyName " left" (LeaveDir %1) " as you entered.\n")
  360.      ELSEIF    ($and    ($eq @MyNew @HisNew) ($eq @HisOld @HisNew))    THEN
  361.         (Tell @Him @MyName " entered" (EnterDir %1) ".\n")
  362.      ELSEIF    ($and    ($eq @MyNew @HisNew) ($ne @HisOld @HisNew)
  363.             ($ne @MyOld @HisOld))
  364.      THEN
  365.         (Tell @Him @MyName " enters" (EnterDir %1) " as you enter.\n")
  366.     )
  367.     ($setg I ($minus @I 1))
  368.     ($setg Him ($global ($plus Actors @I)))
  369.     )
  370.  
  371.     { Examine those actors who haven't already acted }
  372.     ($setg I ($minus @I 1))
  373.     (WHILE ($ge @I 0) DO
  374.     ($setg Him ($global ($plus Actors @I)))
  375.     ($setg HisNew ($loc @Him))
  376.     (IF    ($eq @MyOld @HisNew)    THEN
  377.         (Tell @Him @MyName " left" (LeaveDir %1) ".\n")
  378.      ELSEIF    ($eq @MyNew @HisNew)    THEN
  379.         (Tell @Him @MyName " entered" (EnterDir %1) ".\n")
  380.     )
  381.     ($setg I ($minus @I 1))
  382.     )
  383. ;
  384.  
  385.  
  386. START =
  387. LOCAL i, num, name, rnum, actor, tty;
  388.     ($sdem Looker)
  389.     ($prompt Prompter)
  390.     ($setv    north south east west
  391.         northeast southeast northwest southwest up down )
  392.     ($say "How many actors? (1-5): ")
  393.     ($setg num ($num ($read)))
  394.     (IF ($or ($lt @num 1) ($gt @num 5)) THEN
  395.     ($say "Bad number of actors.\n")
  396.     ($spec 3)
  397.     )
  398.     ($setg i 0)
  399.     (WHILE ($lt @i @num) DO
  400.     ($say "Enter actor " ($str ($plus @i 1)) "'s name (all lowercase): ")
  401.     ($setg name ($read))
  402.     ($setg rnum 0)
  403.     (WHILE ($or ($lt @rnum 1) ($gt @rnum 4)) DO
  404.         ($say "Enter actor's room number (1-4): ")
  405.         ($setg rnum ($num ($read)))
  406.     )
  407.     ($say "Enter actor's tty (<cr> if none): ")
  408.     ($setg tty ($read))
  409.     ($setg actor ($global ($plus InitAct @i)))
  410.     ($define @name ($name @actor))
  411.     ($setg rnum ($global ($plus Rooms ($minus @rnum 1))))
  412.     (SetActor @name @actor @rnum @tty)
  413.     ($setg i ($plus @i 1))
  414.     )
  415. ;
  416.  
  417. { *** EOF multi.adl *** }
  418.